perm filename DRUM.F4[LX,LCS] blob sn#164491 filedate 1975-06-13 generic text, type T, neo UTF8
C  SETS UP 6 RHYTHMIC LISTS WHICH CAN BE CHOSEN AT RANDOM.
C LOAD THE LIST BY USING INST. '<DUMY'. EACH LIST MUST END WITH 2 NEGS.
	SUBROUTINE SUBR
	COMMON /INS/ INST(27),BG(60)
	COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
C   INUM=INST#  IPAR=PARAM#  
C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
C   F1=86  F15=100 (NO F16!)
	DIMENSION A(7,30)
	EQUIVALENCE (P2,P(2))

	IF(INST(INUM).NE.'<DUMY')GO TO 100
	XP=-1
	K=CNT(INUM)
	DO 40 J=1,7
40	A(J,K)=P(J+2)
C  P3 GOES INT A(1,   P4 → A(2,  ETC.
C  STORES 7 RHYTH LISTS.
	RETURN

100	IF(CNT(INUM).EQ.1)KK=0
	INST(INUM)='FM'
	IF(IPAR.NE.2)GO TO 20
10	IF(KK.NE.0)GO TO 21
	J=P2
	RR=RAND(.7,1.2)
C  RR IS SPEED FACTOR
	REV=RAND(.08,.9)
	FM=RAND(700.,900.)
	FMX=RAND(5.,6.)
	FREQ=RAND(-12.,15.)
21	KK=KK+1
22	P2=A(J,KK)*RR
	DF=A(J,KK+1)
200	IF(P2.AND.DF)KK=0
	IF(KK.GE.30)KK=0
	DF=-.4
	IF(P2)IREST=-1
C  SO NOTE WILL NEVER BE LONGER THAN .4"
	IF(XP.GE.P(1))RETURN
	IF(P2)RETURN
	X=RAND(-10.,20.)
	IF(X)DF=.4/P2
	Q=.4
	IF(X.GT.0)Q=Q*P2
	XP=P(1)+Q
C  1/3 OF THE NOTES ARE LOW AND LONG
	RETURN
20	IF(DF.EQ.-.4)GO TO 31
	P(3)=P(8)+X
C  P8 WILL HAVE LOWNOTE FREQ.
	INST(INUM)='FM2'
31	P(3)=P(3)+FREQ
	IF(RR.LT..9)P(3)=P(3)/RR
	P(8)=FM/P(3)
	P(9)=P(3)*FMX/8.
	IF(P(12))DF=P(12)
C  USE P12 TO RESET DUTY FACT.
	P(12)=REV
	END